home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / parscl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-12-21  |  4.3 KB  |  146 lines
  1. Unit ParseCL;
  2.  
  3. interface
  4.  
  5. {*****************************************************************}
  6.  
  7. type
  8.   ValueType = (_Real, _Integer, _String);
  9.   CLParPtr  = ^CLParType;
  10.   CLParType = record
  11.                 Fwd,
  12.                 Bkwd   : CLParPtr;
  13.                 SwName : String;
  14.                 Case VType : ValueType of
  15.                   _Real    : (VReal : Real);
  16.                   _Integer : (VInt  : LongInt);
  17.                   _String  : (VString : String);
  18.                 end;
  19.  
  20. Procedure ParseCmdLine(StrPtr : Pointer; StrOnly : Boolean; 
  21.                        var X : CLParPtr; var Err : Integer );
  22.  
  23. {*****************************************************************}
  24.  
  25. implementation
  26.  
  27. {*****************************************************************}
  28.  
  29. Procedure ParseCmdLine(StrPtr : Pointer; StrOnly : Boolean; 
  30.                        var X : CLParPtr; var Err : Integer );
  31.   var
  32.     CmdLine    : ^String;
  33.     CLine      : String;
  34.     QuoteState : (Off, Quote1, Quote2);
  35.     Last,
  36.      Current   : CLParPtr;
  37.     T1         : Integer;
  38.   Procedure PackCommandLine( var Err : Integer );
  39.     var
  40.       T1       : Integer;
  41.     begin
  42.       CLine := '';
  43.       QuoteState := Off;
  44.       For T1 := 1 to Length(CmdLine^) do
  45.         Case QuoteState of
  46.           Off    : Case CmdLine^[T1] of
  47.                      ' '  : ;
  48.                      '''' : QuoteState := Quote1;
  49.                      '"'  : QuoteState := Quote2;
  50.                      else   CLine := CLine + CmdLine^[T1];
  51.                      end;
  52.           Quote1 : Case CmdLine^[T1] of
  53.                      '''' : QuoteState := Off;
  54.                      else   CLine := CLine + chr(ord(CmdLine^[T1]) or $80);
  55.                      end;
  56.           Quote2 : Case CmdLine^[T1] of
  57.                      '"'  : QuoteState := Off;
  58.                      else   CLine := CLine + chr(ord(CmdLine^[T1]) or $80);
  59.                      end;
  60.           end;
  61.       If (Length(CLine) > 0) and (CLine[1] <> '/') then
  62.         CLine := '/' + CLine;
  63.       Err := ord(QuoteState);
  64.       end;
  65.   Procedure SetNextLink;
  66.     begin
  67.       New(Current);
  68.       Last^.Fwd := Current;
  69.       Current^.Fwd := Nil;
  70.       Current^.Bkwd := Last;
  71.       Last := Current;
  72.       end;
  73.   Procedure MakeSwitchRecord;
  74.     var
  75.       WorkSpace : String;
  76.       Err       : Integer;
  77.       T1        : Integer;
  78.     begin
  79.       CLine := Copy(Cline, 2, Length(CLine)-1); {Strip leading '/'}
  80.       WorkSpace := CLine;
  81.       If Pos('/',WorkSpace) <> 0 then begin
  82.         WorkSpace[0] := chr(Pos('/',WorkSpace) - 1);
  83.         CLine := Copy(CLine, Pos('/',CLine),
  84.                       Length(CLine)-Pos('/',CLine)+1);
  85.         end
  86.       else
  87.         CLine := '';
  88.       With Current^ do begin
  89.         If Pos('=',WorkSpace) <> 0 then begin
  90.           SwName := Copy(WorkSpace, 1, Pos('=',WorkSpace)-1);
  91.           WorkSpace := Copy(WorkSpace, Pos('=',WorkSpace)+1,
  92.                             Length(WorkSpace)-Pos('=',WorkSpace));
  93.           end
  94.         else begin
  95.           SwName := WorkSpace;
  96.           WorkSpace := '';
  97.           end;
  98.     {Name has been set. Now get type and value}
  99.         If not StrOnly then begin
  100.           If Length(WorkSpace) = 0 then begin
  101.             VType := _String;
  102.             VString := '';
  103.             exit
  104.             end;
  105.           Val(WorkSpace, VInt, Err);
  106.           If Err = 0 then begin
  107.             VType := _Integer;
  108.             exit
  109.             end;
  110.           Val(WorkSpace, VReal, Err);
  111.           If Err = 0 then begin
  112.             VType := _Real;
  113.             exit
  114.             end;
  115.           end; {If not StrOnly}
  116.         VType := _String;
  117.         VString := '';
  118.         For T1 := 1 to Length(WorkSpace) do
  119.           VString := VString + chr(ord(WorkSpace[T1]) and $7F);
  120.         end
  121.       end;
  122.   begin {ParseCmdLine}
  123.     If StrPtr = nil then
  124.       CmdLine := Ptr(PrefixSeg, $0080)
  125.     else
  126.       CmdLine := StrPtr;
  127.     PackCommandLine(Err);
  128.     If Length(CLine) = 0 then begin
  129.       X := Nil;
  130.       exit
  131.       end;
  132.     New(Current);
  133.     X := Current;
  134.     Last := Current;
  135.     Current^.Fwd := Nil;
  136.     Current^.Bkwd := Nil;
  137.     MakeSwitchRecord;
  138.     While Pos('/',CLine) <> 0 do begin
  139.       SetNextLink;
  140.       MakeSwitchRecord;
  141.       end;
  142.     end; {ParseCmdLine}
  143.  
  144. {**********************************************************}
  145. end.
  146.